home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM 1995 Fall / PD-ROM F95.toast / Utilities / FKeys / FKeys A-L / ClickLoc FKEY 2.0 ƒ / ClickLoc FKEY.p < prev    next >
Encoding:
Text File  |  1992-10-04  |  10.3 KB  |  369 lines  |  [TEXT/ttxt]
  1. {    ClickLoc FKEY © 1991-92 by Jon Wind                                                        }
  2. {    Version 1.0 on 1/4/91                                                                            }
  3. {    Version 1.1 on 6/20/91                                                                        }
  4. {    Version 2.0 on 10/4/92                                                                        }
  5.  
  6. {    This FKEY lets you draw a rectangle on the screen and displays it's coordinates.        }
  7.  
  8. {     Thanks to Brad Pettit and his colorfkey for his method of conditional compilation.    }
  9.  
  10. {    To execute this as a program...                                                                }
  11. {        1. change the definition of fkey to false                                                    }
  12. {        2. set the project type to application                                                    }
  13. {        3. change the library from drvrruntime.lib to µruntime.lib                            }
  14. {        4. rebuild the project}
  15.  
  16.  
  17. {$setc fkey := true}
  18.  
  19. {$ifc fkey}
  20.  
  21. unit ClickLocFKEY;
  22.  
  23. interface
  24.  
  25.     procedure main;
  26.  
  27. implementation
  28.  
  29. {$elsec}
  30.  
  31.     program ClickLocFKEY;
  32.  
  33. {$endc}
  34.  
  35.         procedure main;
  36.             const
  37.                 vers = 'v2.0';
  38.                 enterKey = 3;
  39.                 lastValIndex = 5;
  40.                 bCommandKey = 48;
  41.                 bShiftKey = 63;
  42.                 bControlKey = 60;
  43.                 bOptionKey = 61;
  44.                 bCapsLockKey = 62;
  45.                 gridSize = 50;
  46.                 MarqueeDelay = 2;
  47.             type
  48.                 myIntArray = array[0..lastValIndex] of Integer;
  49.                 myLabelArray = array[0..lastValIndex] of string[7];
  50.             var
  51.                 dlgPtr: DialogPtr;
  52.                 theRect, oldRect, menuRect: Rect;
  53.                 savePort: GrafPtr;
  54.                 CMenuPtr: MCEntryPtr;
  55.                 p: grafport;
  56.                 itmHdl: Handle;
  57.                 theEvent: EventRecord;
  58.                 done, usingColor, hasLocal, useLocal, hasGrid: Boolean;
  59.                 grayPat, gridPat, marqueePat: Pattern;
  60.                 startPoint, endPoint: Point;
  61.                 h, i, theFont, baseLine, menuHeight: Integer;
  62.                 IntPtr: ^Integer;
  63.                 lastDraw: LongInt;
  64.                 LabelArray: myLabelArray;
  65.                 oldIntArray, IntArray, WidthArray: myIntArray;
  66.                 CrossCursHndl: CursHandle;
  67.                 theStr: string[25];
  68.                 fInfo: FontInfo;
  69.  
  70.  
  71.             function GetMBarHeight: Integer;
  72.     { get current menu bar height }
  73.                 var
  74.                     thePtr: ^Integer;
  75.             begin
  76.                 thePtr := Pointer($BAA);
  77.                 GetMBarHeight := thePtr^;
  78.             end;  { of func GetMBarHeight }
  79.  
  80.             function IsColor: Boolean;
  81.     { return true if using 16 or more "colors" }
  82.                 var
  83.                     maindevice: GDHandle;
  84.                     theWorld: SysEnvRec;
  85.             begin
  86.                 IsColor := False;
  87.                 if (SysEnvirons(1, theWorld) <> envNotPresent) then    { SysEnvirons call available? }
  88.                     if theWorld.hasColorQD then        { has Color QuickDraw }
  89.                         begin
  90.                             maindevice := GetMainDevice;
  91.                             IsColor := (maindevice^^.gdPMap^^.pixelsize > 2);        { 16 or more shades? }
  92.                         end;
  93.             end;{ of func IsColor }
  94.  
  95.             function myGetGrayRgn: Handle;
  96.     { get current gray region }
  97.                 var
  98.                     thePtr: ^Handle;
  99.             begin
  100.                 thePtr := Pointer($9EE);
  101.                 myGetGrayRgn := thePtr^;
  102.             end;  { of func GetGrayRgn }
  103.  
  104.             function GetKeyDown (index: Integer): Boolean;
  105.     { return the state of the desired key - true if down; false if up }
  106.                 var
  107.                     keys: keymap;
  108.             begin
  109.                 GetKeys(keys);
  110.                 GetKeyDown := bittst(@keys, index);        { look at entry within the key map }
  111.             end;
  112.  
  113.             procedure DoDrawGrid;
  114.     { get current menu bar height }
  115.                 var
  116.                     i: Integer;
  117.                     thePen: PenState;
  118.             begin
  119.                 GetPenState(thePen);                { save current pen }
  120.                 PenPat(gridPat);
  121.                 for i := 1 to p.visRgn^^.RgnBBox.right div gridSize do
  122.                     begin
  123.                         MoveTo(i * gridSize, menuRect.bottom + 2);
  124.                         LineTo(i * gridSize, p.visRgn^^.RgnBBox.bottom);
  125.                     end;
  126.                 for i := 1 to p.visRgn^^.RgnBBox.bottom div gridSize do
  127.                     begin
  128.                         MoveTo(p.visRgn^^.RgnBBox.left, i * gridSize);
  129.                         LineTo(p.visRgn^^.RgnBBox.right, i * gridSize);
  130.                     end;
  131.                 SetPenState(thePen);                { restore old pen }
  132.                 hasGrid := not hasGrid;
  133.             end;  { of proc DoDrawGrid }
  134.  
  135.             function aNum2Str (aNum: LongInt): Str255;
  136.     { NumToString procedure available as a function }
  137.                 var
  138.                     NumStr: Str255;
  139.             begin
  140.                 NumToString(aNum, NumStr);
  141.                 aNum2Str := NumStr;
  142.             end;
  143.  
  144.             procedure rotateByte (p: Ptr);
  145.             inline
  146.                 $205F, $1010, $E218, $1080;
  147. {        move.l  (sp)+,a0}
  148. {        move.b  (a0),d0}
  149. {        ror.b   #1,d0}
  150. {        move.b  d0,(a0)}
  151.  
  152.  
  153.             procedure DrawMarquee (oldRect, newRect: Rect);
  154.                 var
  155.                     i: Integer;
  156.             begin
  157.                 lastDraw := TickCount;
  158.                 for i := 0 to 7 do                    { set up blinking marquee pattern by shifting bits }
  159.                     rotateByte(@marqueePat[i]);
  160.                 FrameRect(oldRect);                { erase old rect }
  161.                 PenPat(marqueePat);
  162.                 FrameRect(newRect);                { draw new rect }
  163.             end;  { of proc DrawMarquee }
  164.  
  165.  
  166.  
  167.  { --------- Main Procedure --------- }
  168.         begin
  169.             GetPort(savePort);            { save current grafport }
  170.  
  171.             hasLocal := (FrontWindow <> nil);
  172. {•   if not hasLocal then•}
  173. {•    sysbeep(1);•}
  174.  
  175.             StuffHex(@grayPat, 'AA55AA55AA55AA55');
  176.             StuffHex(@gridPat, '55FF77FF55FF77FF');
  177.             StuffHex(@marqueePat, '0F1E3C78F0E1C387');
  178.  
  179.             SetRect(oldRect, 0, 0, 0, 0);
  180.             LabelArray[0] := 'Left:';
  181.             LabelArray[1] := 'Top:';
  182.             LabelArray[2] := 'Right:';
  183.             LabelArray[3] := 'Bottom:';
  184.             LabelArray[4] := 'Height:';
  185.             LabelArray[5] := 'Width:';
  186.             done := False;
  187.             hasGrid := False;
  188.             lastDraw := 0;
  189.             for i := 0 to lastValIndex do
  190.                 IntArray[i] := 0;
  191.  
  192.             CrossCursHndl := GetCursor(crosscursor);
  193.             MoveHHi(Handle(CrossCursHndl));
  194.             HLock(Handle(CrossCursHndl));
  195.  
  196.             usingColor := IsColor;
  197.             if usingcolor then
  198.                 begin
  199.                     OpenCPort(@p);            { open as current port }
  200.                     CMenuPtr := GetMCEntry(0, 0);
  201.                     if CMenuPtr <> nil then
  202.                         begin
  203.                             RGBForeColor(CMenuPtr^.mctRGB1);
  204.                             RGBBackColor(CMenuPtr^.mctRGB4);
  205.                         end;
  206.                 end
  207.             else
  208.                 OpenPort(@p);                { open as current port }
  209.  
  210.             GetFNum('Geneva', theFont);
  211.             TextFont(theFont);
  212.             TextSize(9);
  213.             GetFontInfo(fInfo);
  214.             menuHeight := GetMBarHeight;
  215.             baseLine := Pred(((menuHeight - (fInfo.ascent + fInfo.descent)) div 2) + fInfo.ascent);
  216.             SetRect(menuRect, 1, 0, p.portrect.right, menuHeight - 1);
  217.             EraseRoundRect(menuRect, 12, 12);
  218.  
  219.             PenPat(grayPat);
  220.             PenMode(notPatXor);            { allows easy redrawing of gray frames }
  221.             UnionRgn(p.visRgn, RgnHandle(myGetGrayRgn), p.visRgn);        { adjust new port to allow drawing on all screens }
  222.             UnionRgn(p.clipRgn, RgnHandle(myGetGrayRgn), p.clipRgn);    { adjust new port to allow drawing on all screens }
  223.  
  224.             TextFace([bold]);
  225.             Moveto(6, baseLine);
  226.             DrawString('ClickLoc FKEY by Jon Wind.');
  227.             TextFace([]);
  228.             DrawString(' Click & drag. Caps Lock for grid. Press a key to end.');
  229.  
  230.             if hasLocal then
  231.                 dlgPtr := FrontWindow;
  232.  
  233.             repeat
  234.                 repeat
  235.                     if (GetKeyDown(bCapsLockKey) and not hasGrid) or (hasGrid and not GetKeyDown(bCapsLockKey)) then
  236.                         DoDrawGrid;
  237.  
  238.                     if (TickCount >= lastDraw + MarqueeDelay) then {& not EmptyRect(oldRect)}
  239.                         DrawMarquee(oldRect, oldRect);
  240.  
  241.                     SetCursor(CrossCursHndl^^);
  242.                 until GetOSEvent(EveryEvent, theEvent);
  243.                 case theEvent.what of
  244.                     autokey, keyDown: 
  245.                         begin
  246.                             done := True;
  247.                             if BitAnd(theEvent.message, CharCodeMask) = enterKey then    { copy to scrap if Enter key pressed }
  248.                                 begin
  249.                                     theStr := Concat(aNum2Str(IntArray[0]), ',', aNum2Str(IntArray[1]), ',', aNum2Str(IntArray[2]), ',', aNum2Str(IntArray[3]));
  250.                                     if ZeroScrap = noErr then
  251.                                         lastDraw := PutScrap(Length(theStr), 'TEXT', Pointer(@theStr[1]));
  252.                                 end;
  253.                         end;
  254.                     mouseDown: 
  255.                         begin
  256.                             useLocal := hasLocal & (GetKeyDown(bShiftKey) or GetKeyDown(bCommandKey) or GetKeyDown(bOptionKey) or GetKeyDown(bControlKey));
  257.                             if useLocal then
  258.                                 begin
  259.                                     SetPort(dlgPtr);            { restore grafport to front window }
  260.                                     GetMouse(startPoint);
  261.                                     SetPort(@p);                    { restore grafport }
  262.                                 end
  263.                             else
  264.                                 GetMouse(startPoint);
  265.  
  266.                             FrameRect(oldRect);    { erase old rect }
  267.                             EraseRoundRect(menuRect, 12, 12);            { clear menu bar area }
  268.                             SetRect(oldRect, 0, 0, -1, -1);
  269.                             TextFace([bold]);
  270.                             moveto(menuRect.left + 10, baseLine);
  271.                             if useLocal then
  272.                                 DrawString('L')
  273.                             else
  274.                                 DrawString('G');
  275.                             moveto(35, baseLine);
  276.                             for i := 0 to lastValIndex do
  277.                                 begin
  278.                                     WidthArray[i] := StringWidth(LabelArray[i]);
  279.                                     DrawString(LabelArray[i]);
  280.                                     move(36, 0);
  281.  
  282.                                     oldIntArray[i] := maxint;
  283.                                 end;
  284.                             TextFace([]);
  285.                             MoveTo(menuRect.right - StringWidth(Vers) - 5, baseLine);
  286.                             DrawString(Vers);
  287.  
  288.                             repeat
  289.                                 if useLocal then
  290.                                     SetPort(dlgPtr);            { restore grafport }
  291.  
  292.                                 GetMouse(endPoint);
  293.  
  294.                                 if (endPoint.h >= startPoint.h) and (endPoint.v >= startPoint.v) then
  295.                                     SetRect(theRect, startPoint.h, startPoint.v, endPoint.h, endPoint.v)
  296.                                 else if (endPoint.h > startPoint.h) and (endPoint.v < startPoint.v) then
  297.                                     SetRect(theRect, startPoint.h, endPoint.v, endPoint.h, startPoint.v)
  298.                                 else if (endPoint.h < startPoint.h) and (endPoint.v > startPoint.v) then
  299.                                     SetRect(theRect, endPoint.h, startPoint.v, startPoint.h, endPoint.v)
  300.                                 else
  301.                                     SetRect(theRect, endPoint.h, endPoint.v, startPoint.h, startPoint.v);
  302.  
  303.                                 IntArray[0] := theRect.left;
  304.                                 IntArray[1] := theRect.top;
  305.                                 IntArray[2] := theRect.right;
  306.                                 IntArray[3] := theRect.bottom;
  307.                                 IntArray[4] := theRect.bottom - theRect.top;
  308.                                 IntArray[5] := theRect.right - theRect.left;
  309.  
  310.                                 if useLocal then
  311.                                     begin
  312.                                         SetPort(dlgPtr);            { restore grafport }
  313.                                         LocalToGlobal(theRect.topLeft);
  314.                                         LocalToGlobal(theRect.botRight);
  315.                                         SetPort(@p);            { restore grafport }
  316.                                     end;
  317.  
  318.                                 if not EqualRect(oldRect, theRect) then
  319.                                     begin
  320.                                         DrawMarquee(oldRect, theRect);
  321.  
  322.                                         h := 0;
  323.                                         for i := 0 to lastValIndex do
  324.                                             begin
  325.                                                 h := h + WidthArray[i];
  326.                                                 SetRect(oldRect, 37 + (36 * i) + h, menuRect.top, (36 * i) + h + 65, menuRect.bottom);
  327.                                                 moveto(oldRect.left, baseLine);
  328.                                                 if IntArray[i] <> oldIntArray[i] then
  329.                                                     begin
  330.                                                         EraseRect(oldRect);
  331.                                                         DrawString(aNum2Str(IntArray[i]));
  332.                                                         oldIntArray[i] := IntArray[i];
  333.                                                     end;
  334.                                             end;
  335.  
  336.                                         oldRect := theRect;        { save current rect for later erasure }
  337.                                     end;
  338.  
  339.                                 if (TickCount >= lastDraw + MarqueeDelay) then
  340.                                     DrawMarquee(oldRect, oldRect);
  341.                             until not StillDown;
  342.                         end;
  343.                     otherwise
  344.                 end;
  345.             until done;
  346.  
  347.             FrameRect(oldRect);        { erase old rect }
  348.             if hasGrid then
  349.                 DoDrawGrid;                { erase old grid }
  350.             if usingcolor then
  351.                 CloseCPort(@p)
  352.             else
  353.                 ClosePort(@p);
  354.             InitCursor;
  355.             HUnLock(Handle(CrossCursHndl));
  356. {•   ReleaseResource(Handle(CrossCursHndl));•}
  357.             SetPort(savePort);            { restore grafport }
  358.             DrawMenuBar;                    { fix menubar }
  359.         end;    { main }
  360.  
  361.  
  362. {$ifc fkey = false}
  363.  
  364.     begin
  365.         main;
  366.  
  367. {$endc}
  368.  
  369.     end.